Attribute VB_Name = "VDTCtrl"
'========================================================
'OBJECT CONTROL
'Version 1
'Methods
'Initalize
'Load
'Save
'
'========================================================
Option Explicit
DefInt A-Z

Private Const DEFDDEAPP = "RSLINX"
Private Const DEFDDETOPIC = "aPlus"
Private Const DEFDDEITEM = "S:23"
Private Const DEFDESCTEXT = "Default"
Private Const ALIGN_DEF = 1
Private Const DEFDISPWIDTH = 40
Private Const DEFDISPHEIGHT = 16

Public Const ALIGN_0 = 1
Public Const ALIGN_1 = 2
Public Const ALIGN_2 = 1
Public Const ALIGN_3 = 2

'Part of LinkObjDB
Private Type ItemType
    Deleted  As Boolean    'Deleted, will not be saved in the next save
    Writable As Boolean 'Dbl Click brings up write requester
    LinkWriteItem As String 'When link is writable, write to this item, use same scaling.
    Type  As Integer    '0 = RAW 1 = Digital 2 = Analog
    OnState  As String    'Text desc for the On State
    OffState  As String    'Text desc for the Off State
    Scl  As Single    'Scale for analog scaling
    Offset  As Single    'Offset for analog scaling
    Round  As Integer    'Rounding Dec Point
    DUseColor As Integer   '1 = use color on digital points
    DOnColor As Long   'On Color
    DOffColor As Long   'Off Color
End Type

Private Type ObjTagType
    Selected As Boolean
End Type

'Describe a data type to hold the personality of the cData control.
Private Type VdtObjDB
    LinkRun As Boolean   'True if DDE Links being updated
    ModeRun As Boolean   'True if not in edit/mode mode
    Count As Integer   'Count of obj's in the DB
    Index As Integer   'Pointer to the currently selected VDC object
    Disp As Object   'Reference to the DISP object
    Link As Object   'Reference to the LINK object
    Desc As Object   'Reference to the DESC object
    Item() As ItemType   'Values not stored in Label Ctrls
    ObjTag() As ObjTagType
End Type

'DIM a public data to allow access to the objects
Public Vdt As VdtObjDB

'-----------------------------------------
'Initalize
'-----------------------------------------

Sub Initalize()
    
    'Set references to the controls used on the MMI form.
    Set Vdt.Disp = MMI.Disp
    Set Vdt.Link = MMI.Link
    Set Vdt.Desc = MMI.Desc

    'Reset/Initalize database
    objReset
    objClone
End Sub

'+  ===================================
'+  ObjAdd
'+  ===================================
Private Function objAdd()
    Vdt.Count = Vdt.Count + 1
    ReDim Preserve Vdt.Item(0 To Vdt.Count)
    ReDim Preserve Vdt.ObjTag(0 To Vdt.Count)
    Load Vdt.Disp(Vdt.Count)
    Load Vdt.Link(Vdt.Count)
    Load Vdt.Desc(Vdt.Count)
    Vdt.Disp(Vdt.Count).ToolTipText = "Index: " & Vdt.Count
    Vdt.Item(Vdt.Count).Deleted = False
    objAdd = Vdt.Count 'return index of just added obj
End Function

'+  ===================================
'+  ObjClone
'+  ===================================
Sub objClone()
    Dim CloneParent, Clone
    CloneParent = Vdt.Index: If CloneParent < 0 Then CloneParent = 0 'Parent Index
    Clone = objAdd 'create a new instance
    
    'Clone its Disp Obj
    Vdt.Disp(Clone).Left = Vdt.Disp(CloneParent).Left + LAY.SnapX
    Vdt.Disp(Clone).Top = Vdt.Disp(CloneParent).Top + LAY.SnapY
    Vdt.Disp(Clone).Alignment = Vdt.Disp(CloneParent).Alignment
    Vdt.Disp(Clone).Appearance = Vdt.Disp(CloneParent).Appearance
    Vdt.Disp(Clone).BackColor = Vdt.Disp(CloneParent).BackColor
    Vdt.Disp(Clone).Alignment = Vdt.Disp(CloneParent).Alignment
    Vdt.Disp(Clone).Width = Vdt.Disp(CloneParent).Width
    Vdt.Disp(Clone).Height = Vdt.Disp(CloneParent).Height
    Vdt.Disp(Clone).Visible = True
    Vdt.Disp(Clone).ZOrder

    'Clone its Link Obj
    Vdt.Link(Clone).LinkItem = Vdt.Link(CloneParent).LinkItem
    Vdt.Link(Clone).LinkTopic = Vdt.Link(CloneParent).LinkTopic

    'Clone its Desc Obj
    Vdt.Desc(Clone) = Vdt.Desc(CloneParent)
    Vdt.Desc(Clone).Left = Vdt.Desc(CloneParent).Left + LAY.SnapX
    Vdt.Desc(Clone).Top = Vdt.Desc(CloneParent).Top + LAY.SnapY
    Vdt.Desc(Clone).Visible = True
    Vdt.Desc(Clone).ZOrder
    
    'Clone it's Item data
    Vdt.Item(Clone).Writable = Vdt.Item(CloneParent).Writable
    Vdt.Item(Clone).LinkWriteItem = Vdt.Item(CloneParent).LinkWriteItem
    Vdt.Item(Clone).Deleted = Vdt.Item(CloneParent).Deleted
    Vdt.Item(Clone).Offset = Vdt.Item(CloneParent).Offset
    Vdt.Item(Clone).OffState = Vdt.Item(CloneParent).OffState
    Vdt.Item(Clone).OnState = Vdt.Item(CloneParent).OnState
    Vdt.Item(Clone).Scl = Vdt.Item(CloneParent).Scl
    Vdt.Item(Clone).Round = Vdt.Item(CloneParent).Round
    Vdt.Item(Clone).Type = Vdt.Item(CloneParent).Type
    Vdt.Item(Clone).DUseColor = Vdt.Item(CloneParent).DUseColor
    Vdt.Item(Clone).DOnColor = Vdt.Item(CloneParent).DOnColor
    Vdt.Item(Clone).DOffColor = Vdt.Item(CloneParent).DOffColor
    VdtUpDateToolTip Clone

    'Start its Link if required
    If Vdt.Link(CloneParent).LinkMode = vbLinkAutomatic Or Vdt.LinkRun Then
        On Error Resume Next
        Vdt.Link(Clone).LinkMode = vbLinkAutomatic
        DoEvents
        On Error GoTo 0
    End If
End Sub

'+  ===================================
'+  ObjDelete
'+  ===================================
Sub objDelete()
    Vdt.Disp(Vdt.Index).Visible = False
    Vdt.Desc(Vdt.Index).Visible = False
    Vdt.Item(Vdt.Index).Deleted = True
    If Vdt.Link(Vdt.Index).LinkMode <> vbLinkNone Then
        On Error Resume Next
        Vdt.Link(Vdt.Index).LinkMode = vbLinkNone
        DoEvents
    End If
End Sub

'-----------------------------------------
'   ObjReset
'-----------------------------------------
Sub objReset()
    Dim pT
    
    'Unload existing instances
    On Error Resume Next 'dde link can cause errors while stopping
    'stop ddelink and remove all controls
    For pT = 1 To Vdt.Count
        Vdt.Link(pT).LinkMode = vbLinkNone
        DoEvents
        Unload Vdt.Link(pT)
        Unload Vdt.Desc(pT)
        Unload Vdt.Disp(pT)
    Next
    On Error GoTo 0  'normal error handling
    
    'Reset database & default objects (3 labels).
    ReDim Vdt.Item(0 To 0)
    Vdt.Count = 0
    Vdt.Index = -1
    Vdt.LinkRun = False
    Vdt.Item(0).Deleted = False
    Vdt.Item(0).Writable = False
    Vdt.Item(0).LinkWriteItem = ""
    Vdt.Item(0).Offset = 0
    Vdt.Item(0).OffState = "Off"
    Vdt.Item(0).OnState = "On"
    Vdt.Item(0).Scl = 1
    Vdt.Item(0).Offset = 0
    Vdt.Item(0).Round = 2
    Vdt.Item(0).Type = 0
    Vdt.Item(0).DUseColor = 0
    Vdt.Item(0).DOnColor = vbWhite
    Vdt.Item(0).DOffColor = vbWhite
    
    
    Vdt.Disp(0).Caption = "000.00 "
    Vdt.Disp(0).WordWrap = True
    Vdt.Disp(0).Alignment = ALIGN_DEF
    Vdt.Disp(0).Left = OBJResetLeft
    Vdt.Disp(0).Top = OBJResetTop
    Vdt.Disp(0).Width = OBJResetWidth
    Vdt.Disp(0).Height = OBJResetHeight
    Vdt.Disp(0).Visible = False
    Vdt.Disp(0).Font.Bold = False
    Vdt.Disp(0).BackColor = vbWhite
    Vdt.Disp(0).Width = DEFDISPWIDTH
    Vdt.Disp(0).Height = DEFDISPHEIGHT
    
    Vdt.Desc(0).Left = Vdt.Disp(0).Left + Vdt.Disp(0).Width + LAY.DescXos
    Vdt.Desc(0).Top = Vdt.Disp(0).Top + LAY.DescYos
    Vdt.Desc(0).Caption = DEFDESCTEXT
    Vdt.Desc(0).Visible = False
    
    Vdt.Link(0).LinkTopic = DEFDDEAPP & "|" & DEFDDETOPIC
    Vdt.Link(0).LinkItem = DEFDDEITEM
    
    VdtUpDateToolTip 0
    
End Sub

'-----------------------------------------
'   DISP to FRONT
'-----------------------------------------
Sub objToFront()
    Vdt.Disp(Vdt.Index).ZOrder 0
    Vdt.Desc(Vdt.Index).ZOrder 0
End Sub

'-----------------------------------------
'   DISP to BACK
'-----------------------------------------
Sub objToBack()
    Vdt.Disp(Vdt.Index).ZOrder 1
    Vdt.Desc(Vdt.Index).ZOrder 1
End Sub

'-----------------------------------------------------------------------
'   LAYOUT SAVE
'-----------------------------------------------------------------------
Sub LayoutSave()
    Dim fPt
    fPt = FreeFile
    Open LAY.ObjFileName For Output As fPt
        Dim pT
        Print #fPt, getObjRecForFile(-1) 'Print a tab file header
        For pT = 1 To Vdt.Count
        If Vdt.Item(pT).Deleted = False Then
            Print #fPt, getObjRecForFile(pT) ''Print the data record
        End If
        Next
    Close fPt
End Sub

'-----------------------------------------------------------------------
'   Compose a record to write to the layout file
'-----------------------------------------------------------------------
Private Function getObjRecForFile(VdtPt) As String
    Dim S As String
    Dim tAppTopic() As String
    Dim tApp As String
    Dim tTopic As String
    Select Case VdtPt
        Case -1
             S = S & "LinkApp" & vbTab
             S = S & "LinkTopic" & vbTab
             S = S & "LinkItem" & vbTab
             S = S & "Writable" & vbTab
             S = S & "LinkWriteItem" & vbTab
             S = S & "Desc" & vbTab
             S = S & "Type" & vbTab
             S = S & "OnState" & vbTab
             S = S & "OffState" & vbTab
             S = S & "Scl" & vbTab
             S = S & "Offset" & vbTab
             S = S & "Round" & vbTab
             S = S & "Disp.Left" & vbTab
             S = S & "Disp.Top" & vbTab
             S = S & "Disp.Width" & vbTab
             S = S & "Disp.Height" & vbTab
             S = S & "Item.DUseColor" & vbTab
             S = S & "Item.DOnColor" & vbTab
             S = S & "Item.DOffColor" & vbTab
             S = S & "Desc.Visible" & vbTab
             S = S & "Desc.Left" & vbTab
             S = S & "Desc.Top" & vbTab
        Case Is >= 0
            tAppTopic() = Split(Vdt.Link(VdtPt).LinkTopic, "|")
            If UBound(tAppTopic) = 1 Then
                tApp = tAppTopic(0)
                tTopic = tAppTopic(1)
            End If
            S = S & tApp & vbTab
            S = S & tTopic & vbTab
            S = S & Vdt.Link(VdtPt).LinkItem & vbTab
            S = S & Vdt.Item(VdtPt).Writable & vbTab
            S = S & Vdt.Item(VdtPt).LinkWriteItem & vbTab
            S = S & Vdt.Desc(VdtPt).Caption & vbTab
            S = S & Vdt.Item(VdtPt).Type & vbTab
            S = S & Vdt.Item(VdtPt).OnState & vbTab
            S = S & Vdt.Item(VdtPt).OffState & vbTab
            S = S & Vdt.Item(VdtPt).Scl & vbTab
            S = S & Vdt.Item(VdtPt).Offset & vbTab
            S = S & Vdt.Item(VdtPt).Round & vbTab
            S = S & Vdt.Disp(VdtPt).Left & vbTab
            S = S & Vdt.Disp(VdtPt).Top & vbTab
            S = S & Vdt.Disp(VdtPt).Width & vbTab
            S = S & Vdt.Disp(VdtPt).Height & vbTab
            S = S & Vdt.Item(VdtPt).DUseColor & vbTab
            S = S & Vdt.Item(VdtPt).DOnColor & vbTab
            S = S & Vdt.Item(VdtPt).DOffColor & vbTab
            S = S & Vdt.Desc(VdtPt).Visible & vbTab
            S = S & Vdt.Desc(VdtPt).Left - Vdt.Disp(VdtPt).Left & vbTab
            S = S & Vdt.Desc(VdtPt).Top - Vdt.Disp(VdtPt).Top & vbTab
    End Select
    getObjRecForFile = S
End Function

'-----------------------------------------------------------------------
'   LAYOUT LOAD
'-----------------------------------------------------------------------
Sub LayoutLoad()
    If Not CheckIfFileExists(LAY.ObjFileName) Then Exit Sub
    Const MinFldCnt = 7
    Dim fPt, LastFld, FldPt, VdtPt, RecPt
    Dim tApp As String
    Dim tTopic As String
    Dim RecIN As String 'each line from the layout file goes here for spliting to flds.
    Dim FldIn() As String 'each record is split to fields.
    Dim KeyIn() As String 'tab seperated layout file - field header.
    
    fPt = FreeFile
    Open LAY.ObjFileName For Input As fPt
        objReset 'reset the existing instances
        While Not EOF(fPt)
            Line Input #fPt, RecIN
            RecPt = RecPt + 1
            FldIn() = Split(RecIN, vbTab)
            Select Case RecPt
                Case 1  'record 0 - the header and keys field. Retain for matching fields.
                    For FldPt = 0 To UBound(FldIn)
                        If FldIn(FldPt) <> "" Then
                            ReDim Preserve KeyIn(0 To FldPt)
                            KeyIn(FldPt) = FldIn(FldPt)
                            LastFld = FldPt
                        Else
                            LastFld = FldPt - 1
                            Exit For
                        End If
                    Next
                    
                Case Is > 1 'object record - make it and restore its properties
                    FldIn() = Split(RecIN, vbTab)
                    VdtPt = objAdd 'Make a new instance
                    'Restore properties - allocate by field title.
                    For FldPt = 0 To LastFld
                        Select Case KeyIn(FldPt)
                            Case "LinkApp": tApp = FldIn(FldPt)
                            Case "LinkTopic": tTopic = FldIn(FldPt)
                            Case "LinkItem": Vdt.Link(VdtPt).LinkItem = FldIn(FldPt)
                            Case "Writable": Vdt.Item(VdtPt).Writable = FldIn(FldPt)
                            Case "LinkWriteItem": Vdt.Item(VdtPt).LinkWriteItem = FldIn(FldPt)
                            Case "Desc": Vdt.Desc(VdtPt).Caption = FldIn(FldPt)
                            Case "Type": Vdt.Item(VdtPt).Type = FldIn(FldPt)
                            Case "OnState": Vdt.Item(VdtPt).OnState = FldIn(FldPt)
                            Case "OffState": Vdt.Item(VdtPt).OffState = FldIn(FldPt)
                            Case "Scl": Vdt.Item(VdtPt).Scl = FldIn(FldPt)
                            Case "Offset": Vdt.Item(VdtPt).Offset = FldIn(FldPt)
                            Case "Round": Vdt.Item(VdtPt).Round = FldIn(FldPt)
                            Case "Disp.Left": Vdt.Disp(VdtPt).Left = FldIn(FldPt)
                            Case "Disp.Top": Vdt.Disp(VdtPt).Top = FldIn(FldPt)
                            Case "Disp.Width": Vdt.Disp(VdtPt).Width = FldIn(FldPt)
                            Case "Disp.Height": Vdt.Disp(VdtPt).Height = FldIn(FldPt)
                            Case "Item.DUseColor": Vdt.Item(VdtPt).DUseColor = FldIn(FldPt)
                            Case "Item.DOnColor": Vdt.Item(VdtPt).DOnColor = FldIn(FldPt)
                            Case "Item.DOffColor": Vdt.Item(VdtPt).DOffColor = FldIn(FldPt)
                            Case "Desc.Visible": Vdt.Desc(VdtPt).Visible = FldIn(FldPt)
                            Case "Desc.Left": Vdt.Desc(VdtPt).Left = FldIn(FldPt) + Vdt.Disp(VdtPt).Left
                            Case "Desc.Top": Vdt.Desc(VdtPt).Top = FldIn(FldPt) + Vdt.Disp(VdtPt).Top
                        End Select
                    Next
                    If tApp <> "" And tTopic <> "" Then Vdt.Link(VdtPt).LinkTopic = tApp & "|" & tTopic
                    Select Case Vdt.Item(VdtPt).Type
                        Case 0: Vdt.Disp(VdtPt).Alignment = ALIGN_0
                        Case 1: Vdt.Disp(VdtPt).Alignment = ALIGN_1
                        Case 2: Vdt.Disp(VdtPt).Alignment = ALIGN_2
                        Case 3: Vdt.Disp(VdtPt).Alignment = ALIGN_3
                    End Select
                    'Tooltip
                    VdtUpDateToolTip VdtPt
                    Vdt.Disp(VdtPt).Visible = True
                    Vdt.Disp(VdtPt).ZOrder 'leave in front
                    'Set Writeable Disp Style
                    If Vdt.Item(VdtPt).Writable = True Then
                        Vdt.Disp(VdtPt).Font.Bold = True
                    End If
                    Vdt.Disp(VdtPt).BackColor = vbWhite
            End Select
        Wend
    Close fPt
End Sub

'-----------------------------------------------------------------------
'   Check if a file exists
'-----------------------------------------------------------------------
Private Function CheckIfFileExists(FilePathNameExt As String) As Boolean
    On Error GoTo fileerr
    If FileLen(FilePathNameExt) > 0 Then
        CheckIfFileExists = True
    Else
        CheckIfFileExists = False
    End If
    Exit Function
fileerr:
    CheckIfFileExists = False
End Function

'-----------------------------------------------------------------------
'   Extracts the APP or TOPIC from a Label.LinkTopic prop.
'-----------------------------------------------------------------------
Private Function getDDEAppName(LblTopic As String) As String
    If LblTopic <> "" And InStr(LblTopic, "|") > 0 Then
        getDDEAppName = Trim(Left(LblTopic, InStr(LblTopic, "|") - 1))
    Else
        getDDEAppName = ""
    End If
End Function

Private Function getDDETopicName(LblTopic As String) As String
    If LblTopic <> "" And InStr(LblTopic, "|") > 0 Then
        getDDETopicName = Trim(Mid(LblTopic, InStr(LblTopic, "|") + 1))
    Else
        getDDETopicName = ""
    End If
End Function

Sub VdtUpDateToolTip(pT As Integer)
    Vdt.Disp(pT).ToolTipText = pT & " - " & Vdt.Desc(pT) & " - " & Vdt.Link(pT).LinkTopic & "!" & Vdt.Link(pT).LinkItem
End Sub
